home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / HTML and CSS Modes / hctsmslShared.tcl < prev    next >
Encoding:
Text File  |  1997-11-18  |  29.0 KB  |  933 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML and CSS mode - tools for editing Cascading Style Sheets
  4.  # 
  5.  #  FILE: "hctsmslShared.tcl"
  6.  #                                    created: 97-04-05 18.39.51 
  7.  #                                last update: 18/11/97 {1:06:31 pm} 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0.3 and 1.0.3
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc hctsmslShared.tcl {} {}
  25.  
  26.  
  27. # A list of URLs, cached, to pick from for insertion
  28. newPref v URLs {} HTML
  29.  
  30. # Home pages, set the old one if it exists.
  31. if {[info exists homePagePath] && [string length $homePagePath] && 
  32. [info exists HTMLmodeVars(baseURL)] && [string length $HTMLmodeVars(baseURL)]} {
  33.     if {![info exists HTMLmodeVars(basePath)]} {set HTMLmodeVars(basePath) ""}
  34.     newPref v homePages [list [list [string trimright $homePagePath :] $HTMLmodeVars(baseURL) $HTMLmodeVars(basePath) "index.html"]] HTML
  35.     lappend modifiedModeVars {homePages HTMLmodeVars}
  36. } else {
  37.     newPref v homePages {} HTML
  38. }
  39.  
  40.  
  41. # Carriage return
  42. proc HTML::carriageReturn {} {
  43.     global indentOnCR mode
  44.     
  45.     if { [isSelection] } { deleteSelection }
  46.     insertText "\r"
  47.     if {$indentOnCR} {
  48.         ${mode}::indentLine
  49.         if {![htmlIsWhite [set pre [getText [lineStart [getPos]] [getPos]]]]} {
  50.             regexp {^[ \t]*} $pre white
  51.             goto [expr [lineStart [getPos]] + [string length $white]]
  52.         }
  53.     }
  54. }
  55.  
  56.  
  57. # A boolean function which takes any string and tests to see if
  58. # that string contains all whitespace characters.  Carriage returns 
  59. # are considered whitespace, as are spaces and tabs.
  60. proc htmlIsWhite {anyString} {
  61.     return [regexp {^[ \t\r\n]*$} $anyString]
  62. }
  63.  
  64. # Checks if the current position is inside the container ELEM.
  65. proc htmlIsInContainer {elem} {
  66.     set exp1 "<${elem}(\[ \t\r\]+\[^<>\]*>|>)"
  67.     set exp2 "</${elem}>"
  68.     set pos [getPos]
  69.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $exp1 $pos} res1] && $pos > [lindex $res1 1] &&
  70.     ([catch {search -s -f 0 -r 1 -i 1 -m 0 $exp2 $pos} res2] || 
  71.     [lindex $res1 0] > [lindex $res2 0])} {
  72.         return 1
  73.     }
  74.     return 0
  75. }
  76.  
  77. # Determines the path to the include folder corresponding to path.
  78. # If none, return empty string.
  79. proc htmlWhichInclFolder {path} {
  80.     global HTMLmodeVars
  81.     foreach p $HTMLmodeVars(homePages) {
  82.         if {[string match "[lindex $p 0]:*" $path]} {return [lindex $p 4]:}
  83.     }
  84.     return ""
  85. }
  86.  
  87. proc htmlResolveInclPath {txt path} {
  88.     regsub -nocase {^:INCLUDE:} $txt $path txt
  89.     return $txt
  90. }
  91.  
  92. # Escapes certain characters in URLs.
  93. proc htmlURLescape {str {slash 0}} {
  94.     set hexa {0 1 2 3 4 5 6 7 8 9 A B C D E F}
  95.     set nstr ""
  96.     set exp "\[\001- \177-ˇ%<>\"#\?=&;|\\{\\}\\`^"
  97.     if {$slash} {append exp "/"}
  98.     append exp "\]"
  99.     while {[regexp -indices $exp $str c]} {
  100.         set asc [text::Ascii [string index $str [lindex $c 0]]]
  101.         append nstr [string range $str 0 [expr [lindex $c 0] - 1]]
  102.         append nstr % [lindex $hexa [expr $asc / 16]] [lindex $hexa [expr $asc % 16]]        
  103.         set str [string range $str [expr [lindex $c 1] + 1] end]
  104.     }
  105.     return "$nstr$str"
  106. }
  107.  
  108. proc htmlURLescape2 {str} {
  109.     set url ""
  110.     regexp {[^#]*} $str url
  111.     set anchor [string range $str [string length $url] end]
  112.     return "[htmlURLescape $url]$anchor"
  113. }
  114.  
  115. # Translate escaped characters in URLs.
  116. proc htmlURLunEscape {str} {
  117.     set hexa {0 1 2 3 4 5 6 7 8 9 A B C D E F}
  118.     set nstr ""
  119.     while {[regexp -indices {%[0-9A-F][0-9A-F]} $str hex]} {
  120.         append nstr [string range $str 0 [expr [lindex $hex 0] - 1]]
  121.         append nstr [text::Ascii [expr 16 * [lsearch $hexa [string index $str [expr [lindex $hex 0] + 1]]] \
  122.         + [lsearch $hexa [string index $str [expr [lindex $hex 0] + 2]]]] 1]
  123.         set str [string range $str [expr [lindex $hex 1] + 1] end]
  124.     }
  125.     return "$nstr$str"
  126. }
  127.  
  128. # Adds a URL or window given as input to cache
  129. proc htmlAddToCache {cache newurl} {
  130.     global modifiedModeVars HTMLmodeVars htmlModeIsLoaded
  131.     
  132.     if {$cache == "windows" && [lsearch -exact {_self _top _parent _blank} $newurl] >= 0} {return}
  133.     set URLs $HTMLmodeVars($cache)
  134.     
  135.     if {[string length $newurl] && [lsearch -exact $URLs $newurl] < 0} { 
  136.         set URLs [lsort [lappend URLs $newurl]]
  137.         set HTMLmodeVars($cache) $URLs
  138.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  139.         if {[llength $URLs] == 1 && [info exists htmlModeIsLoaded]} {htmlEnable$cache on}
  140.     }
  141. }
  142.  
  143.  
  144. # Puts up a window with error text.
  145. proc htmlErrorWindow {errHeader errText {cancelButton 0}} {
  146.     
  147.     set errbox "-t {$errHeader} 100 10 400 25"
  148.     set hpos 35
  149.     foreach err $errText {
  150.         lappend errbox -t $err 10 $hpos 400 [expr $hpos + 15]
  151.         incr hpos 20
  152.     }
  153.     if {$cancelButton} {
  154.         lappend errbox -b Cancel 105 [expr $hpos + 20 ] 170 [expr $hpos + 40 ]
  155.     }
  156.     
  157.     set val [eval [concat dialog -w 430 -h [expr $hpos + 50 ] \
  158.     -b OK 20 [expr $hpos + 20 ] 85 [expr $hpos + 40 ] $errbox]]
  159.     return [lindex $val 0]
  160. }
  161.  
  162. # Caches
  163. proc htmlSaveCache {cache text {type html}} {
  164.     global PREFS htmlVersion cssVersion
  165.     if {![file exists $PREFS]} {mkdir $PREFS}
  166.     if {![file exists $PREFS:HTML]} {mkdir $PREFS:HTML}
  167.     set fid [open $PREFS:HTML:$cache w]
  168.     puts $fid "#[set ${type}Version]"
  169.     puts $fid $text
  170.     close $fid
  171. }
  172.  
  173. proc htmlReadCache {cache {type html}} {
  174.     global PREFS htmlVersion cssVersion
  175.     if {![file exists $PREFS:HTML:$cache]} {error "No cache."}
  176.     set fid [open $PREFS:HTML:$cache r]
  177.     gets $fid version
  178.     if {![regexp {^#[0-9]+\.[0-9]+$} $version] || $version != "#[set ${type}Version]"} {
  179.         close $fid
  180.         htmlDeleteCache $cache
  181.         error "Wrong version."
  182.     }
  183.     close $fid
  184.     uplevel #0 [list source $PREFS:HTML:$cache]
  185. }
  186.  
  187. proc htmlDeleteCache {cache} {
  188.     global PREFS
  189.     catch {removeFile $PREFS:HTML:$cache}
  190. }
  191.  
  192. #===============================================================================
  193. # File routines
  194. #===============================================================================
  195.  
  196. # Asks for a file and returns the file name including the relative path from
  197. # current window. For images the width and height are also returned.
  198. proc htmlGetFile {{linkFile ""} {errormsg 0}} {
  199.     upvar pathToNewFile newFile
  200.     # get path to this window.    
  201.     if {![string length [set this [htmlThisFilePath $errormsg]]]} {return}
  202.     
  203.     # Get the file to link to.
  204.     if {$linkFile == "" && [catch {getfile "Select file to link to."} linkFile]} {
  205.         return 
  206.     }
  207.     # For htmlLinkToNewFile
  208.     set newFile $linkFile
  209.     # Get URL for this file?
  210.     set link [htmlBASEfromPath $linkFile]
  211.     if {[lindex $link 4] == "4"} {
  212.         alertnote "You can't link to a file in an include folder."
  213.         return
  214.     }
  215.     if {[lindex $this 0] == [lindex $link 0]} {
  216.         set linkTo [htmlRelativePath "[lindex $this 1][lindex $this 2]" "[lindex $link 1][lindex $link 2]"]
  217.     } else {
  218.         set linkTo [join [lrange $link 0 2] ""]
  219.     }
  220.     set widthheight ""
  221.     if {![file isdirectory $linkFile]} {
  222.         # Check if image file.
  223.         getFileInfo $linkFile arr
  224.         if {$arr(type) == "GIFf"} {
  225.             set widthheight [htmlGIFWidthHeight $linkFile]
  226.         } elseif {$arr(type) =="JPEG" || $arr(type) == "JFIF"} {
  227.             set widthheight [htmlJPEGWidthHeight $linkFile]
  228.         }
  229.     } else {
  230.         append linkTo /
  231.     }
  232.     
  233.     # Add URL to cache.
  234.     htmlAddToCache URLs $linkTo
  235.     return [list $linkTo $widthheight]
  236. }
  237.  
  238.  
  239. # Returns the URL to the current window.
  240. proc htmlThisFilePath {errorMsg} {
  241.     
  242.     set thisFile [stripNameCount [lindex [winNames -f] 0]]
  243.     
  244.     # Look for BASE element.
  245.     if {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<BASE[ \t\r]+[^>]*>} 0} res]} {
  246.         set comm 0
  247.         set commPos 0
  248.         while {![catch {search -s -f 1 -r 0 -m 0 -l [lindex $res 0] {<!--} $commPos} cres]} {
  249.             set comm 1
  250.             if {![catch {search -s -f 1 -r 0 -m 0 -l [lindex $res 0] -- {-->} [expr [lindex $cres 1] + 1]} cres]} {
  251.                 set comm 0
  252.                 set commPos [lindex $cres 1]
  253.             } else {
  254.                 break
  255.             }
  256.         }
  257.         if {!$comm && [regexp -nocase {HREF=\"?([^ \t\r\">]+)} [getText [lindex $res 0] \
  258.         [lindex $res 1]] dum href]} {
  259.             if {[catch {htmlBASEpieces $href} basestr]} {
  260.                 alertnote "Window contains invalid BASE element. Ignored."
  261.             } else {
  262.                 return $basestr
  263.             }
  264.         }
  265.     }
  266.     
  267.     # Check if window is saved.
  268.     if {![file exists $thisFile]} {
  269.         switch $errorMsg {
  270.             0 {
  271.                 set etxt "You must save the window. If you save, you will then be prompted\
  272.                 for a file to link to."
  273.             }
  274.             1 {
  275.                 set etxt "You must save the window, otherwise it cannot be determined\
  276.                 where the link is pointing."
  277.             }
  278.             2 {
  279.                 set etxt "You must save the window, otherwise the link cannot be determined."
  280.             }
  281.             3 {
  282.                 set etxt "You must save the window, otherwise it cannot be determined\
  283.                 where the links are pointing."
  284.             }
  285.             4 {
  286.                 set etxt "You must save the window, otherwise it cannot be determined\
  287.                 where to upload it."
  288.             }
  289.         }
  290.         if {[lindex [dialog -w 400 -h 100 -t $etxt 10 10 390 60  \
  291.         -b Save 20 70  85 90 \
  292.         -b Cancel 110 70 175 90] 1]} {
  293.             return
  294.         }
  295.         
  296.         if {![catch {saveAs "Untitled.html"}]} {
  297.             set thisFile [stripNameCount [lindex [winNames -f] 0]]
  298.         } else {
  299.             return 
  300.         }
  301.     }
  302.     return [htmlBASEfromPath $thisFile]
  303. }
  304.  
  305. # Returns URL to file.
  306. proc htmlBASEfromPath {path} {
  307.     global HTMLmodeVars
  308.     foreach p $HTMLmodeVars(homePages) {
  309.         if {(![set i 0] && [string match "[lindex $p $i]:*" "$path:"]) || 
  310.         ([llength $p] == 5 && [set i 4] && [string match "[lindex $p $i]:*" "$path:"])} {
  311.             set path [string range $path [expr [string length [lindex $p $i]] + 1] end]
  312.             regsub -all {:} $path {/} path
  313.             return [list [lindex $p 1] [lindex $p 2] $path [lindex $p 0] $i [lindex $p 4]]
  314.         }
  315.     }
  316.     regsub -all {:} $path {/} path
  317.     return [list "file:///" "" $path "" 0]
  318. }
  319.  
  320. # Splits a BASE URL in pieces.
  321. # NOTE! That this proc returns a shorter list than the proc above, is used in
  322. # HTML::DblClick to determine if the doc contains a BASE tag.
  323. proc htmlBASEpieces {href} {
  324.     if {[regexp -indices {://} $href css]} {
  325.         if {[set sl [string first / [string range $href [expr [lindex $css 1] + 1] end]]] >=0} {
  326.             set base [string range $href 0 [expr [lindex $css 1] + $sl + 1]]
  327.             set path [string range $href [expr [lindex $css 1] + $sl + 2] end]
  328.             set sl [string last / $path]
  329.             set epath [string range $path [expr $sl + 1] end]
  330.             set path [string range $path 0 $sl]
  331.         } else {
  332.             set base [string range $href 0 [lindex $css 1]]
  333.             set path ""
  334.             set epath [string range $href [expr [lindex $css 1] + 1] end]
  335.         }
  336.         return [list [htmlURLunEscape $base] [htmlURLunEscape $path] [htmlURLunEscape $epath] ""]
  337.     } else {
  338.         error "Invalid BASE."
  339.     }
  340. }
  341.  
  342.  
  343. # Determines width and height of a GIF file.
  344. proc htmlGIFWidthHeight {fil} {
  345.     if {[catch {open $fil r} fid]} {return}
  346.     seek $fid 6 start
  347.     set width [expr [htmlReadOne $fid] + 256 * [text::Ascii [read $fid 1]]]
  348.     set height [expr [htmlReadOne $fid] + 256 * [text::Ascii [read $fid 1]]]
  349.     close $fid
  350.     return [list $width $height]
  351. }
  352.  
  353. # Extracts width and height of a jpeg file.
  354. # Algorithm from the perl script 'wwwimagesize' by
  355. # Alex Knowles, alex@ed.ac.uk
  356. # Andrew Tong, werdna@ugcs.caltech.edu
  357. proc htmlJPEGWidthHeight {fil} {
  358.     if {[catch {open $fil r} fid]} {return}
  359.     if {[text::Ascii [read $fid 1]] != 255 || [text::Ascii [read $fid 1]] != 216} {return}
  360.     set ch ""
  361.     while {![eof $fid]} {
  362.         while {[text::Ascii $ch] != 255 && ![eof $fid]} {set ch [read $fid 1]}
  363.         while {[text::Ascii $ch] == 255 && ![eof $fid]} {set ch [read $fid 1]}
  364.         if {[set asc [text::Ascii $ch]] >= 192 && $asc <= 195} {
  365.             seek $fid 3 current
  366.             set height [expr 256 * [text::Ascii [read $fid 1]] + [htmlReadOne $fid]]
  367.             set width [expr 256 * [text::Ascii [read $fid 1]] + [htmlReadOne $fid]]
  368.             close $fid
  369.             return [list $width $height]
  370.         } else {
  371.             set ln [expr 256 * [text::Ascii [read $fid 1]] + [text::Ascii [read $fid 1]] - 2]
  372.             if {$ln < 0} {break}
  373.             seek $fid $ln current
  374.         }
  375.     }
  376.     close $fid
  377. }
  378.  
  379. # Reads one character from an image file.
  380. # For some mysterious reason 10 and 13 has to be swapped.
  381. proc htmlReadOne {fid} {
  382.     set c [text::Ascii [read $fid 1]]
  383.     if {$c == 13} {
  384.         set c 10
  385.     } elseif {$c == 10} {
  386.         set c 13
  387.     }
  388.     return $c
  389. }
  390.  
  391.  
  392. # Returns toFile including relative path from fromFile.
  393. proc htmlRelativePath {fromFile toFile} {
  394.     # Remove trailing /file from fromFile
  395.     set fromFile [string range $fromFile 0 [expr [string last / $fromFile] - 1]]
  396.  
  397.     set fromdir [split $fromFile /]
  398.     set todir [split $toFile /]
  399.     
  400.     # Remove the common path.
  401.     set i 0
  402.     while {[llength $fromdir] > $i && [llength $todir] > $i \
  403.     && [lindex $fromdir $i] == [lindex $todir $i]} {
  404.         incr i
  405.     }
  406.  
  407.     # Insert ../
  408.     foreach f [lrange $fromdir $i end] {
  409.         append linkTo "../"
  410.     }
  411.     # Add the path.
  412.     append linkTo [join [lrange $todir $i end] /]
  413.     
  414.     return $linkTo
  415. }
  416.  
  417. # Determine the path to the file "linkTo", as linked from "base path epath". 
  418. proc htmlPathToFile {base path epath hpPath linkTo} {
  419.     global  HTMLmodeVars
  420.  
  421.     # Is this a mailto or news URL or anchor?
  422.     if {[regexp {^(mailto:|news:|javascript:)} [string tolower $linkTo]]} {error $linkTo}
  423.     
  424.     # remove /file from epath
  425.     set sl [string last / $epath]
  426.     set efil [string range $epath [expr $sl + 1] end]
  427.     set epath [string range $epath 0 $sl]
  428.  
  429.     # anchor points to efil
  430.     if {[string index $linkTo 0] == "#"} {set linkTo $efil}
  431.     
  432.     # Remove anchor from "linkTo".
  433.     regexp {[^#]*} $linkTo linkTo
  434.     
  435.     # Remove ./ from path
  436.     if {[string range $linkTo 0 1] == "./"} {set linkTo [string range $linkTo 2 end]}
  437.     
  438.     # Relative URL beginning with / is relative to server URL.
  439.     if {[string index $linkTo 0] == "/"} {
  440.         set linkTo "$base[string range $linkTo 1 end]"
  441.     }
  442.     
  443.     # Relative URL?
  444.     if {![regexp  {://} $linkTo]} {
  445.         set fromPath [split [string trimright "${path}$epath" /] /]
  446.         set toPath [split $linkTo /]
  447.         # Back down for every ../
  448.         set i 0
  449.         foreach tp $toPath {
  450.             if {$tp == ".."} {
  451.                 incr i
  452.             } else {
  453.                 break
  454.             }
  455.         }
  456.         if {$i > [llength $fromPath] } {
  457.             error ""
  458.         } else {
  459.             set path1 [join [lrange $fromPath 0 [expr [llength $fromPath] - $i - 1]] /]
  460.             if {[string length $path1]} {append path1 /}
  461.             append path1 [join [lrange $toPath $i end] /]
  462.             if {[string match "$path*" $path1] && [string length $hpPath]} {
  463.                 set pathTo [string range $path1 [string length $path] end]
  464.                 regsub -all {/} $pathTo {:} pathTo
  465.                 set casePath $pathTo
  466.                 set pathTo "$hpPath:$pathTo"
  467.                 if {![file isdirectory $pathTo]} {return [list $pathTo $casePath]}
  468.             } elseif {$base == "file:///"} {
  469.                 regsub -all {/} $path1 {:} pathTo
  470.                 return [list $pathTo $pathTo]
  471.             }
  472.             set linkTo "$base$path1"
  473.         }
  474.     }
  475.  
  476.     foreach hp [concat $HTMLmodeVars(homePages) {{"" file:/// "" ""}}]  {
  477.         if {[string match "[lindex $hp 1][lindex $hp 2]*" $linkTo] ||
  478.         [string trimright "[lindex $hp 1][lindex $hp 2]" /] == $linkTo} {
  479.             set pathTo [string range $linkTo [string length "[lindex $hp 1][lindex $hp 2]"] end]
  480.             regsub -all {/} $pathTo {:} pathTo
  481.             set casePath $pathTo
  482.             set pathTo [string trimleft "[lindex $hp 0]:$pathTo" :]
  483.             # If link to folder, add default file.
  484.             if {[file isdirectory $pathTo]} {
  485.                 set pathTo [string trimright $pathTo :]
  486.                 append pathTo ":[lindex $hp 3]"
  487.                 set casePath [string trimright $casePath :]
  488.                 append casePath ":[lindex $hp 3]"
  489.             }        
  490.             return [list $pathTo [string trimleft $casePath :]]
  491.         }
  492.     }
  493.     error $linkTo
  494. }    
  495.  
  496. #===============================================================================
  497. # Cmd-Double-click
  498. #===============================================================================
  499.  
  500. proc HTML::DblClick {from to} {
  501.     global htmlURLAttr mode 
  502.     global ${mode}modeVars filepats
  503.     
  504.     # Build regular expressions with URL attrs.
  505.     if {$mode == "HTML"} {
  506.         set exp "("
  507.         foreach attr $htmlURLAttr {
  508.             append exp "$attr|"
  509.         }
  510.         set exp [string trimright $exp |]
  511.         append exp ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  512.     }
  513.  
  514.     set expcss {(url)\(\"?([^\"\)]+)\"?\)}
  515.     # Check if user clicked on a link.
  516.     if {($mode == "HTML" && ![catch {search -s -f 0 -r 1 -i 1 -m 0 $exp $from} res] && [lindex $res 1] > $from) ||
  517.     (![set curl [catch {search -s -f 0 -r 1 -i 1 -m 0 $expcss $from} res]] && [lindex $res 1] > $from)} {
  518.         # Get path to this window.
  519.         if {![string length [set thisURL [htmlThisFilePath 1]]]} {return}
  520.         # Get path to link.
  521.         if {[info exists curl]} {set exp $expcss}
  522.         regexp -nocase $exp [eval getText $res] dum1 dum2 linkTo
  523.         set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  524.         # Anchors points to file itself if no BASE. (No BASE if [llength $thisURL] > 4)
  525.         if {[string index $linkTo 0] == "#" && [llength $thisURL] > 4} {
  526.             if {![catch {search -s -f 1 -r 1 -i 1 -m 0 \
  527.                 "<(\[Aa\]|\[mM\]\[aA\]\[pP\])\[ \t\r\n\]+\[^>\]*\[nN\]\[aA\]\[mM\]\[eE\]=\"?[string range $linkTo 1 end]\"?(>|\[ \t\r\n\]+\[^>\]*>)" 0} anc]} {
  528.                 goto [lindex $anc 0]
  529.             }
  530.             return
  531.         }
  532.         if {[catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  533.             if {$linkToPath == ""} {
  534.                 message "Link not well-defined."
  535.             } else {
  536.                 message "Link points to $linkToPath. Doesn't map to a file on the disk."
  537.             }
  538.             return
  539.         }
  540.         # Does the file exist? 
  541.         if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  542.             # Is it a text file?
  543.             if {[getFileType $linkToPath] == "TEXT"} {
  544.                 edit -c $linkToPath
  545.             } elseif {[set ${mode}modeVars(openNonTextFile)] && [getFileType $linkToPath] != "APPL"} {
  546.                 launchDoc $linkToPath
  547.             } else {
  548.                 message "[file tail $linkToPath] is not a text file."
  549.             }
  550.         } else {
  551.             set isAnHtmlFile 0
  552.             set sufficies ""
  553.             foreach mm {HTML CSS JScr} {
  554.                 if {[info exists filepats($mm)]} {set sufficies [concat $sufficies $filepats($mm)]}
  555.             }
  556.             foreach suffix $sufficies {
  557.                 if {[string match $suffix $linkToPath]} {set isAnHtmlFile 1}
  558.             }
  559.             if {(![file exists $linkToPath] && !$isAnHtmlFile) || [file isdirectory $linkToPath] ||
  560.             ![regexp {[^:]+} $linkToPath disk] || ![file exists $disk:]} {
  561.                 message "Cannot open [file tail $linkToPath]."
  562.             } else {
  563.                 set htmlFile [file tail $linkToPath]
  564.                 if {[lindex [dialog -w 350 -h 140 -t "The file '$htmlFile' does not exist.\
  565.                 Do you want to open a new empty window with this name?\
  566.                 It will automatically be saved in the right place,\
  567.                 and if necessary, new folders will be created."  10 10 340 100 \
  568.                 -b Yes 20 110 85 130 -b No 115 110 180 130] 1]} {return}
  569.                 # Create a new file and open it.
  570.                 foreach p [split [file dirname $linkToPath] :] {
  571.                     append path "$p:"
  572.                     # make new folders if needed.
  573.                     if {![file exists $path]} {
  574.                         mkdir $path
  575.                     } elseif {![file isdirectory $path]} {
  576.                         alertnote "Cannot make a new folder '[file tail $path]'.\
  577.                         There is already a file with the same name."
  578.                         return
  579.                     }
  580.                 }
  581.                 append path "$htmlFile"
  582.                 # create an empty file.
  583.                 set fid [open $path w]
  584.                 # I suppose it's best to close it, too.
  585.                 close $fid
  586.                 edit $path
  587.             }
  588.         }
  589.     } elseif {$mode == "HTML"} { 
  590.         if {![catch {search -s -f 0 -r 1 -i 1 -m 0 {FILE=\"[^\"]+\"} $from} res] && [lindex $res 1] > $from} {
  591.             regexp -nocase {FILE=\"([^\"]+)\"} [eval getText $res] dum fil
  592.             set fil [htmlResolveInclPath [htmlUnQuote $fil] [htmlWhichInclFolder [stripNameCount [lindex [winNames -f] 0]]]]
  593.             if {[file exists $fil]} {
  594.                 edit -c $fil
  595.             } else {
  596.                 message "File not found."
  597.             }
  598.         } elseif {[htmlIsInContainer SCRIPT]} {
  599.             global HOME
  600.             select $from $to
  601.             set word [getText $from $to]
  602.             if {[grep "^$word$" [lindex [glob $HOME:JSreference:index*] 0]] != ""} {
  603.                 editMark [lindex [glob $HOME:JSreference:JS*] 0] $word -r
  604.             }
  605.         } elseif {![htmlRevealColor 1]} {
  606.             htmlChangeDblClick
  607.         }
  608.     }
  609. }
  610.  
  611. #==============================================================================
  612. #    Colors
  613. #==============================================================================
  614.  
  615. # Convert colour names to numbers and vice versa.
  616. # Or brings up a color picker if cmd-doubleClick.
  617. proc htmlRevealColor {{dblClick 0}} {
  618.     global htmlColorName htmlColorNumber htmlColorAttr htmluserColors 
  619.     global htmluserColorname
  620.  
  621.     set searchstring "("
  622.     foreach s $htmlColorAttr {
  623.         append searchstring "${s}|"
  624.     } 
  625.     # remove last |
  626.     set searchstring [string trimright $searchstring |]
  627.     append searchstring ")(\"(\[^\"\]*)\"|(\[^ \\t\\r\">\]*))"
  628.     set startpos [getPos]
  629.     set endpos [selEnd]
  630.     set cantfind 0
  631.     # find attribute
  632.     set f [search -s -f 0 -r 1 -i 1 -n -m 0 $searchstring $startpos]
  633.     if {![string length $f] || [lindex $f 1] < $endpos} {
  634.         set cantfind 1
  635.     }
  636.     if {!$cantfind} {
  637.         set txt [getText [lindex $f 0] [lindex $f 1]]
  638.         regexp -indices -nocase $searchstring $txt a b c
  639.         set cpos [expr [lindex $f 0] + [lindex $c 0]]
  640.         set epos [expr [lindex $f 0] + [lindex $c 1] + 1]
  641.         set col [string trim [string range $txt [lindex $c 0] [lindex $c 1]] \"]
  642.         if {!$dblClick} {
  643.             if {[info exists htmlColorName($col)]} {
  644.                 replaceText $cpos $epos "\"$htmlColorName($col)\""
  645.             } elseif {[info exists htmlColorNumber($col)]} {
  646.                 replaceText $cpos $epos "\"$htmlColorNumber($col)\""
  647.             } elseif {[info exists htmluserColorname($col)]} {
  648.                 replaceText $cpos $epos "\"$htmluserColorname($col)\""
  649.             } elseif {[info exists htmluserColors($col)]} {
  650.                 replaceText $cpos $epos "\"$htmluserColors($col)\""
  651.             } else {
  652.                 beep
  653.                 message "Don't recognize color."
  654.             }
  655.         } else {
  656.             if {[set ncol [htmlCheckColorNumber $col]] != "0"} {
  657.                 set ncol [htmlHexColor $ncol]
  658.             } else {
  659.                 set ncol {65535 65535 65535}
  660.             }
  661.             set newcolor [eval [concat colorTriple {{Change color}} $ncol]]
  662.             if {[string length $newcolor]} {
  663.                 replaceText $cpos $epos "\"[htmlColorHex $newcolor]\""
  664.             }
  665.             return 1
  666.         }
  667.     } elseif {!$dblClick} {
  668.         beep
  669.         message "Current position is not at a color attribute."
  670.     } else {
  671.         return 0
  672.     }
  673. }
  674.  
  675. # Dialog to handle colors.
  676. proc htmlColors {} {
  677.     global htmluserColors
  678.  
  679.     set this ∞
  680.     while {1} {
  681.         set colors [lsort [array names htmluserColors]]
  682.         set box "-t {Colors:} 10 10 80 30 \
  683.         -t Number: 10 50 80 70 \
  684.         -b Done 10 100 75 120 -b New… 90 100 155 120 -b {New by number…} 250 10 375 30"
  685.         if {[llength $colors]} {
  686.             append box " -m [list [concat [list $this] $colors]] 90 10 230 30"
  687.             append box " -b Change… 168 100 237 120 -b Remove 250 100 315 120 \
  688.             -b {Change number…} 250 40 375 60 -b View… 250 70 315 90"
  689.             foreach c $colors {
  690.                 lappend box -n $c -t $htmluserColors($c) 90 50 160 90
  691.             }
  692.         } else {
  693.             append box  " -m {{None defined} {None defined}} 90 10 230 30"
  694.         }
  695.         set values [eval [concat dialog -w 380 -h 130 $box]]
  696.         set this [lindex $values 3]
  697.         if {[lindex $values 0]} {
  698.             return
  699.         } elseif {[lindex $values 1]} {
  700.             set newc [htmlAddNewColor]
  701.             if {[string length $newc]} {set this $newc}
  702.         } elseif {[lindex $values 2]} {
  703.             set newc [htmlNameColor "" "Color saved." "" ""]
  704.             if {[string length $newc]} {set this $newc}
  705.         } elseif {[lindex $values 4]} {
  706.             set newcolor [eval [concat colorTriple [list $this] [htmlHexColor $htmluserColors($this)]]]
  707.             if {![string length $newcolor]} {continue}
  708.             set newc [htmlNameColor [htmlColorHex $newcolor] "Color changed." $this $htmluserColors($this)]
  709.             if {[string length $newc]} {set this $newc}        
  710.         } elseif {[lindex $values 5]} {
  711.             if {[askyesno "Remove $this?"] == "yes"} {
  712.                 htmlColordelete $this $htmluserColors($this)
  713.                 message "Color removed."
  714.             }
  715.         } elseif {[lindex $values 6]} {
  716.             set newc [htmlNameColor "" "Color changed." $this $htmluserColors($this)]
  717.             if {[string length $newc]} {set this $newc}        
  718.         } else {
  719.             eval [concat colorTriple [list $this] [htmlHexColor $htmluserColors($this)]]
  720.         }
  721.     }
  722. }
  723.  
  724. # Checks if colornumber is identical to another colour.
  725. proc htmlColorIdentical {colornumber changeColor} {
  726.     global htmlColorNumber htmluserColorname
  727.     if {( ![catch {set colTest $htmlColorNumber($colornumber)}] || \
  728.     ![catch {set colTest $htmluserColorname($colornumber)}] ) && \
  729.     $colTest != $changeColor} {
  730.         alertnote "This color is identical with '$colTest'. Two identical \
  731.         colors cannot be defined."
  732.         return 1
  733.     }
  734.     return 0
  735. }
  736.  
  737. # Converts a red green blue number to hex.
  738. proc htmlColorHex {color} {
  739.     set hexa {A B C D E F}
  740.     
  741.     set red [expr [set x [expr round([lindex $color 0] / 256.0)]] < 256 ? $x : 255]
  742.     set green [expr [set x [expr round([lindex $color 1] / 256.0)]] < 256 ? $x : 255]
  743.     set blue [expr [set x [expr round([lindex $color 2] / 256.0)]] < 256 ? $x : 255]
  744.     set cols [list [expr $red / 16] [expr $red % 16] [expr $green / 16] [expr $green % 16] [expr $blue / 16] [expr $blue % 16]]
  745.     set colornumber {#}
  746.     foreach c $cols {
  747.         if {$c > 9} {
  748.             set c1 [lindex $hexa [expr $c - 10]]
  749.         } else {
  750.             set c1 $c
  751.         }
  752.         append colornumber $c1
  753.     }
  754.     return $colornumber
  755. }
  756.  
  757. # Converts a hex number to red green blue.
  758. proc htmlHexColor {number} {
  759.     foreach c [split [string range $number 1 end] ""] {
  760.         switch $c {
  761.             A    {set c1 10}
  762.             B    {set c1 11}
  763.             C    {set c1 12}
  764.             D    {set c1 13}
  765.             E    {set c1 14}
  766.             F    {set c1 15}
  767.             default {set c1 $c}
  768.         }
  769.         lappend numbers $c1
  770.     }
  771.     set red [expr [lindex $numbers 0] * 4096 + [lindex $numbers 1] * 256]
  772.     set green [expr [lindex $numbers 2] * 4096 + [lindex $numbers 3] * 256]
  773.     set blue [expr [lindex $numbers 4] * 4096 + [lindex $numbers 5] * 256]
  774.     return [list $red $green $blue]
  775. }    
  776.  
  777. proc htmlAddNewColor {} {
  778.     set newcolor [colorTriple "New color"]    
  779.     if {![string length $newcolor]} {return }
  780.     return [htmlNameColor [htmlColorHex $newcolor] "Color saved." "" ""]
  781. }
  782.  
  783. proc htmlNameColor {colornumber msg changeColor changeNumber} {
  784.     global htmluserColors basicColors
  785.     set alluserColors [array names htmluserColors]
  786.     set noname 1
  787.     set picker [string length $colornumber]
  788.     set values [list $changeColor $changeNumber]
  789.     while {$noname} {
  790.         if {!$picker} {
  791.             if {[string length $changeColor]} {
  792.                 set ttt Change
  793.             } else {
  794.                 set ttt New
  795.             }
  796.             set values [dialog -w 300 -h 150 -t "$ttt color" 50 10 250 30 \
  797.             -t "Name:" 10 45 75 65 -e [lindex $values 0] 80 45 290 60 \
  798.             -t "Number:" 10 75 75 95 -e [lindex $values 1] 80 75 150 90 \
  799.             -b OK 20 120 85 140 -b Cancel 110 120 175 140]
  800.             
  801.             if {[lindex $values 3]} {return}
  802.             set colorname [string trim [lindex $values 0]]
  803.             set colornumber [string trim [lindex $values 1]]
  804.             set coltest [htmlCheckColorNumber $colornumber]
  805.             if {$coltest == "0"} {
  806.                 alertnote "$colornumber is not a valid color number. It should be of the form #RRBBGG."
  807.                 continue
  808.             }
  809.             set colornumber $coltest
  810.             if {[htmlColorIdentical $colornumber $changeColor]} {return}
  811.         } else {
  812.             if {[htmlColorIdentical $colornumber $changeColor]} {return}
  813.             if {[catch {prompt "Color name" $changeColor} colorname]} { 
  814.                 # cancel
  815.                 return
  816.             }
  817.             set colorname [string trim $colorname]
  818.         }
  819.         if {[lsearch -exact $basicColors $colorname] >= 0} {
  820.             alertnote "Predefined color. Choose another name."
  821.         } elseif {[string length $colorname]} {
  822.             set replace 0
  823.             if {[lsearch -exact $alluserColors $colorname] >= 0 && \
  824.             $colorname != $changeColor} {
  825.                 set repl [dialog -w 200 -h 75 -b Cancel 20 40 80 60 \
  826.                 -b Replace 115 40 175 60 \
  827.                 -t "Replace $colorname?" 10 10 150 30]
  828.                 if {[lindex $repl 1] } { 
  829.                     set replace 1
  830.                     # remove the color first 
  831.                     set oldnumber $htmluserColors($colorname)
  832.                     htmlColordelete $colorname $oldnumber
  833.                 }
  834.             } else {
  835.                 set replace 1
  836.             }
  837.             # add the new color
  838.             if {$replace} { 
  839.                 if {[string length $changeColor]} {
  840.                     htmlColordelete $changeColor $changeNumber
  841.                 }
  842.                 set noname 0
  843.                 htmlColordef $colorname $colornumber
  844.                 message $msg
  845.             }
  846.         } else {
  847.             alertnote "You must name the color."
  848.         }
  849.     }
  850.     return $colorname
  851. }
  852.  
  853.  
  854. proc htmlColordef {colorname colornumber} {
  855.     global htmluserColors htmluserColorname
  856.     
  857.     set htmluserColors($colorname) $colornumber
  858.     set htmluserColorname($colornumber) $colorname
  859.     addArrDef htmluserColors $colorname $colornumber
  860.     addArrDef htmluserColorname $colornumber $colorname
  861. }
  862.  
  863. proc htmlColordelete {colorname colornumber} {
  864.     global htmluserColors htmluserColorname
  865.     
  866.     catch {unset htmluserColors($colorname)}
  867.     catch {unset htmluserColorname($colornumber)}
  868.     removeArrDef htmluserColors $colorname
  869.     removeArrDef htmluserColorname $colornumber
  870. }
  871.  
  872.  
  873. # Check if a color number is a valid number, or one of the predefined names.
  874. # Returns 0 if not and the color number if it is.
  875. proc htmlCheckColorNumber {color} {
  876.     global htmlColorName
  877.     set color [string tolower $color]
  878.     if {[info exists htmlColorName($color)]} {return $htmlColorName($color)}
  879.     if {[string index $color 0] != "#"} {
  880.         set color "#${color}"
  881.     }
  882.     set color [string toupper $color]
  883.     if {[string length $color] != 7 || ![regexp {^#[0-9A-F]+$} $color]} {
  884.         return 0
  885.     } else {
  886.         return $color
  887.     }    
  888. }
  889.  
  890. #===============================================================================
  891. # Colors for background, text and links
  892. #===============================================================================
  893.  
  894.  
  895. proc htmlNewColor {var val } {
  896.     global htmlColorName
  897.     global htmlColorNumber
  898.     set htmlColorName($var) $val 
  899.     set htmlColorNumber($val) $var
  900. }
  901. htmlNewColor black        "#000000"
  902. htmlNewColor silver        "#C0C0C0"
  903. htmlNewColor gray        "#808080"
  904. htmlNewColor white        "#FFFFFF"
  905. htmlNewColor maroon        "#800000"
  906. htmlNewColor red        "#FF0000"
  907. htmlNewColor purple        "#800080"
  908. htmlNewColor fuchsia    "#FF00FF"
  909. htmlNewColor green        "#008000"
  910. htmlNewColor lime        "#00FF00"
  911. htmlNewColor olive        "#808000"
  912. htmlNewColor yellow        "#FFFF00"
  913. htmlNewColor navy        "#000080"
  914. htmlNewColor blue        "#0000FF"
  915. htmlNewColor teal        "#008080"
  916. htmlNewColor aqua        "#00FFFF"
  917.  
  918. # Remove colors conflicting with the new ones
  919. foreach tmpCol [array names htmluserColors] {
  920.     if {[info exists htmlColorName($tmpCol)]} {
  921.         htmlColordelete $tmpCol $htmluserColors($tmpCol)
  922.     }
  923. }
  924. foreach tmpCol [array names htmluserColorname] {
  925.     if {[info exists htmlColorNumber($tmpCol)]} {
  926.         htmlColordelete $htmluserColorname($tmpCol) $tmpCol
  927.     }
  928. }
  929. catch {unset tmpCol}
  930. # A list of colours
  931. set basicColors [lsort [array names htmlColorName]]
  932. rename htmlNewColor ""
  933.